home *** CD-ROM | disk | FTP | other *** search
/ Aminet 30 / Aminet 30 (1999)(Schatztruhe)[!][Apr 1999].iso / Aminet / util / libs / PGPLib1_3.lha / PGP / src / pgplib.mod
Text File  |  1998-07-13  |  13KB  |  439 lines
  1. (*(* $Id: pgplib.mod,v 1.9 1998/03/29 11:23:50 andre Exp andre $ *)*)
  2.  
  3. MODULE pgplib;
  4.  
  5. (* $OvflChk- $RangeChk- $StackChk- $NilChk- $ReturnChk- $CaseChk- $OddChk- *)
  6.  
  7. IMPORT
  8.   a  := ASCII,
  9.   c  := Conversions,
  10.   d  := Dos,
  11.   e  := Exec,
  12.   ms := MHStrings,
  13.   p  := Printf,
  14.   rx := Rexx,
  15.   rs := RexxSysLib,
  16.         RVI,
  17.   s  := Strings,
  18.   s0 := Strings0,
  19.   u  := Utility,
  20.   wb := WBPath,
  21.   S  := SYSTEM;
  22.  
  23. CONST
  24.   tagOutFile   = u.user + 1;
  25.   tagUserId    = u.user + 2;
  26.   tagConOutput = u.user + 3;
  27.   tagBinary    = u.user + 4;
  28.   tagBreak     = u.user + 5;
  29.   tagPassword  = u.user + 6;
  30.   tagSign      = u.user + 7;
  31.  
  32.   varname = "pgppass";
  33.  
  34. VAR
  35.   pgppath : e.STRING;
  36.  
  37. PROCEDURE DoCommand (command, conoutput : ARRAY OF CHAR; password : e.LSTRPTR) : LONGINT; (* $CopyArrays- *)
  38. VAR
  39.   ok     : LONGINT;
  40.   path   : d.PathLockPtr;
  41.   stdout : d.FileHandlePtr;
  42.   setvar : BOOLEAN;
  43. BEGIN
  44.   ok := -1;
  45.   path := wb.CloneWorkbenchPath ();
  46.   stdout := d.Open (conoutput, d.oldFile);
  47.   IF stdout # NIL THEN
  48.     IF password # NIL THEN
  49.       (* $OddChk- *)
  50.       setvar := d.SetVar (varname, password^, -1, LONGSET {d.localOnly})
  51.       (* $OddChk= *)
  52.     ELSE
  53.       setvar := FALSE
  54.     END;
  55.     ok := d.SystemTags (command, d.npPath,    S.VAL (LONGINT, path),
  56.                                  d.sysInput,  S.VAL (LONGINT, stdout),
  57.                                  d.sysOutput, S.VAL (LONGINT, NIL),
  58.                                  u.done);
  59.     IF setvar THEN
  60.       IF d.DeleteVar (varname, LONGSET {d.localOnly}) THEN END
  61.     END;
  62.     d.OldClose (stdout)
  63.   END;
  64.   IF ok = -1 THEN
  65.     wb.FreeWorkbenchPath (path)
  66.   END;
  67.   RETURN ok
  68. END DoCommand;
  69.  
  70. PROCEDURE Encrypt * (regfilename {8},
  71.                      reguserid   {9} : e.LSTRPTR;
  72.                      regtagitems {0} : u.TagItemPtr) : LONGINT;
  73. VAR
  74.   filename, userid, outfile,
  75.   signpassword, signuserid : e.LSTRPTR;
  76.   tagitems, tag, tstate    : u.TagItemPtr;
  77.   command, stdout          : ms.STRING;
  78.   ok                       : LONGINT;
  79.   ascii                    : ARRAY 3 OF CHAR;
  80. (* $SaveRegs+ *)
  81. BEGIN
  82.   filename     := regfilename;
  83.   userid       := reguserid;
  84.   tagitems     := regtagitems;
  85.   outfile      := NIL;
  86.   signpassword := NIL;
  87.   signuserid   := NIL;
  88.   ascii        := "a";
  89.   stdout.Set ("*");
  90.   tstate := tagitems;
  91.   tag := u.NextTagItem (tstate);
  92.   WHILE tag # NIL DO
  93.     CASE tag^.tag OF
  94.     | tagBinary    : IF tag^.data # e.LFALSE THEN
  95.                        ascii := ""
  96.                      END
  97.     | tagConOutput : IF tag^.data # NIL THEN
  98.                        (* $OddChk- *)
  99.                        stdout.Set (S.VAL (e.LSTRPTR, tag^.data)^)
  100.                        (* $OddChk= *)
  101.                      END
  102.     | tagOutFile   : IF tag^.data # NIL THEN
  103.                        outfile := tag^.data
  104.                      END
  105.     | tagPassword  : IF tag^.data # NIL THEN
  106.                        signpassword := tag^.data
  107.                      END
  108.     | tagSign      : IF tag^.data # e.LFALSE THEN
  109.                        s.Append (ascii, "s")
  110.                      END
  111.     | tagUserId    : IF tag^.data # NIL THEN
  112.                        signuserid := tag^.data
  113.                      END
  114.     ELSE END;
  115.     tag := u.NextTagItem (tstate)
  116.   END;
  117.   ms.SPrintf (command, "pgp +batchmode -e%s \"%s\" \"%s\"", S.ADR (ascii),
  118.                                                             filename,
  119.                                                             userid);
  120.   IF outfile # NIL THEN
  121.     command.Append (" -o \"");
  122.     (* $OddChk- *)
  123.     command.Append (outfile^);
  124.     (* $OddChk= *)
  125.     command.Append ("\"")
  126.   END;
  127.   IF signuserid # NIL THEN
  128.     command.Append (" -u \"");
  129.     (* $OddChk- *)
  130.     command.Append (signuserid^);
  131.     (* $OddChk= *)
  132.     command.Append ("\"")
  133.   END;
  134.   ok := DoCommand (command.chars^, stdout.chars^, signpassword);
  135.   command.Dispose;
  136.   stdout.Dispose;
  137.   RETURN ok
  138. END Encrypt;
  139.  
  140. PROCEDURE Decrypt * (regfilename {8},
  141.                      regpassword {9} : e.LSTRPTR;
  142.                      regtagitems {0} : u.TagItemPtr) : LONGINT;
  143. VAR
  144.   filename, password, outfile : e.LSTRPTR;
  145.   tagitems, tag, tstate       : u.TagItemPtr;
  146.   ok                          : LONGINT;
  147.   command, stdout             : ms.STRING;
  148. (* $SaveRegs+ *)
  149. BEGIN
  150.   filename := regfilename;
  151.   password := regpassword;
  152.   tagitems := regtagitems;
  153.   outfile  := NIL;
  154.   ok       := -1;
  155.   stdout.Set ("*");
  156.   tstate := tagitems;
  157.   tag := u.NextTagItem (tstate);
  158.   WHILE tag # NIL DO
  159.     CASE tag^.tag OF
  160.     | tagConOutput : IF tag^.data # NIL THEN
  161.                        (* $OddChk- *)
  162.                        stdout.Set (S.VAL (e.LSTRPTR, tag^.data)^)
  163.                        (* $OddChk= *)
  164.                      END
  165.     | tagOutFile   : IF tag^.data # NIL THEN
  166.                        outfile := tag^.data
  167.                      END
  168.     ELSE END;
  169.     tag := u.NextTagItem (tstate)
  170.   END;
  171.   ms.SPrintf (command, "pgp +batchmode \"%s\"", filename);
  172.   IF outfile # NIL THEN
  173.     command.Append (" -o \"");
  174.     (* $OddChk- *)
  175.     command.Append (outfile^);
  176.     (* $OddChk= *)
  177.     command.Append ("\"")
  178.   END;
  179.   ok := DoCommand (command.chars^, stdout.chars^, password);
  180.   command.Dispose;
  181.   stdout.Dispose;
  182.   RETURN ok
  183. END Decrypt;
  184.  
  185. PROCEDURE Sign * (regfilename {8},
  186.                   regpassword {9} : e.LSTRPTR;
  187.                   regtagitems {0} : u.TagItemPtr) : LONGINT;
  188. VAR
  189.   filename, password, outfile, userid : e.LSTRPTR;
  190.   tagitems, tag, tstate               : u.TagItemPtr;
  191.   ok                                  : LONGINT;
  192.   command, stdout                     : ms.STRING;
  193.   ascii                               : CHAR;
  194. (* $SaveRegs+ *)
  195. BEGIN
  196.   filename := regfilename;
  197.   password := regpassword;
  198.   tagitems := regtagitems;
  199.   outfile  := NIL;
  200.   userid   := NIL;
  201.   ascii    := "a";
  202.   ok       := -1;
  203.   stdout.Set ("*");
  204.   tstate := tagitems;
  205.   tag := u.NextTagItem (tstate);
  206.   WHILE tag # NIL DO
  207.     CASE tag^.tag OF
  208.     | tagBreak     : IF tag^.data # e.LFALSE THEN
  209.                        ascii := "b"
  210.                      END
  211.     | tagConOutput : IF tag^.data # NIL THEN
  212.                        (* $OddChk- *)
  213.                        stdout.Set (S.VAL (e.LSTRPTR, tag^.data)^)
  214.                        (* $OddChk= *)
  215.                      END
  216.     | tagOutFile   : IF tag^.data # NIL THEN
  217.                        outfile := tag^.data
  218.                      END
  219.     | tagUserId    : IF tag^.data # NIL THEN
  220.                        userid := tag^.data
  221.                      END
  222.     ELSE END;
  223.     tag := u.NextTagItem (tstate)
  224.   END;
  225.   ms.SPrintf (command, "pgp +batchmode -s%lc \"%s\"", ORD (ascii), filename);
  226.   IF outfile # NIL THEN
  227.     command.Append (" -o \"");
  228.     (* $OddChk- *)
  229.     command.Append (outfile^);
  230.     (* $OddChk= *)
  231.     command.Append ("\"")
  232.   END;
  233.   IF userid # NIL THEN
  234.     command.Append (" -u \"");
  235.     (* $OddChk- *)
  236.     command.Append (userid^);
  237.     (* $OddChk= *)
  238.     command.Append ("\"")
  239.   END;
  240.   ok := DoCommand (command.chars^, stdout.chars^, password);
  241.   command.Dispose;
  242.   stdout.Dispose;
  243.   RETURN ok
  244. END Sign;
  245.  
  246. PROCEDURE Fault * (regcode   {0} : LONGINT;
  247.                    regheader {8},
  248.                    regbuffer {9} : e.LSTRPTR;
  249.                    reglen    {1} : LONGINT) : LONGINT;
  250. TYPE
  251.   Error = RECORD
  252.     code   : LONGINT;
  253.     string : e.LSTRPTR
  254.   END;
  255.   ErrorArray = ARRAY 25 OF Error;
  256.  
  257. CONST
  258.   errors = ErrorArray ( 1, S.ADR ("invalid file"),
  259.                         2, S.ADR ("file not found"),
  260.                         3, S.ADR ("unknown file"),
  261.                         4, S.ADR ("no batch"),
  262.                         5, S.ADR ("bad arg"),
  263.                         6, S.ADR ("interrupt"),
  264.                         7, S.ADR ("out of mem"),
  265.                        10, S.ADR ("keygen error"),
  266.                        11, S.ADR ("key does not exist"),
  267.                        12, S.ADR ("keyring add error"),
  268.                        13, S.ADR ("keyring extract error"),
  269.                        14, S.ADR ("keyring edit error"),
  270.                        15, S.ADR ("keyring view error"),
  271.                        16, S.ADR ("keyring remove error"),
  272.                        17, S.ADR ("keyring check error"),
  273.                        18, S.ADR ("key signature error"),
  274.                        19, S.ADR ("keysig remove error"),
  275.                        20, S.ADR ("signature error"),
  276.                        21, S.ADR ("rsa encryption error"),
  277.                        22, S.ADR ("encryption error"),
  278.                        23, S.ADR ("compress error"),
  279.                        30, S.ADR ("signature check error"),
  280.                        31, S.ADR ("rsa decryption error"),
  281.                        32, S.ADR ("decryption error"),
  282.                        33, S.ADR ("decompress error"));
  283.  
  284. VAR
  285.   code, len              : LONGINT;
  286.   header, buffer, string : e.LSTRPTR;
  287.  
  288.   PROCEDURE GetErrorString (code : LONGINT) : e.LSTRPTR;
  289.   VAR
  290.     index : LONGINT;
  291.   BEGIN
  292.     index := 0;
  293.     LOOP
  294.       IF (index >= LEN (errors)) OR (errors [index].code > code) THEN
  295.         RETURN NIL
  296.       END;
  297.       IF errors [index].code = code THEN
  298.         RETURN errors [index].string
  299.       END;
  300.       INC (index)
  301.     END
  302.   END GetErrorString;
  303.  
  304. (* $SaveRegs+ *)
  305. BEGIN
  306.   code   := regcode;
  307.   header := regheader;
  308.   buffer := regbuffer;
  309.   len    := reglen;
  310.   IF (code # 0) & (buffer # NIL) THEN
  311.     string := GetErrorString (code);
  312.     (* $OddChk- *)
  313.     IF string # NIL THEN
  314.       p.LSPrintF (buffer^, len, "%s", string)
  315.     ELSE
  316.       p.LSPrintF (buffer^, len, "Error %ld", code)
  317.     END;
  318.     IF (header # NIL) & (header^ [0] # a.nul) THEN
  319.       s.Insert (buffer^, 0, ": ");
  320.       s.Insert (buffer^, 0, header^)
  321.     END;
  322.     RETURN s.Length (buffer^)
  323.     (* $OddChk- *)
  324.   ELSE
  325.     RETURN 0
  326.   END
  327. END Fault;
  328.  
  329. PROCEDURE ARexxQuery * (regrexxmsg {8} : rx.RexxMsgPtr) : LONGINT;
  330. VAR
  331.   rexxmsg      : rx.RexxMsgPtr;
  332.   ok, code     : LONGINT;
  333.   result       : UNTRACED POINTER TO ARRAY OF CHAR;
  334.   resultstring : e.LSTRPTR;
  335.   tags         : u.Tags4;
  336.  
  337.   PROCEDURE NumArgs () : LONGINT;
  338.   BEGIN
  339.     RETURN rexxmsg^.action MOD 16
  340.   END NumArgs;
  341.  
  342. (* $SaveRegs+ *)
  343. BEGIN
  344.   rexxmsg := regrexxmsg;
  345.   ok := rx.err10001;
  346.   IF (rexxmsg # NIL) & RVI.CheckRexxMsg (rexxmsg)  &
  347.      (rx.ActionCode (rexxmsg^.action) = rx.rxFunc) &
  348.      (rexxmsg^.args [0] # NIL) THEN
  349.     S.ALLOCATE (result, 256);
  350.     IF result # NIL THEN
  351.       (* -------------------------- Befehl ausführen ------------------------ *)
  352.       (* $OddChk- *)
  353.       IF s0.Compare (rexxmsg^.args [0]^, "PGPEncrypt", FALSE) THEN
  354.         IF NumArgs () >= 3 THEN
  355.           tags [0].tag  := tagOutFile;
  356.           tags [0].data := rexxmsg^.args [3]
  357.         ELSE
  358.           tags [0].tag  := u.ignore
  359.         END;
  360.         IF NumArgs () >= 4 THEN
  361.           tags [1].tag  := tagConOutput;
  362.           tags [1].data := rexxmsg^.args [4]
  363.         ELSE
  364.           tags [1].tag  := u.ignore
  365.         END;
  366.         tags [2].tag  := u.done;
  367.         p.LSPrintF (result^, LEN (result^), "%ld", Encrypt (rexxmsg^.args [1],
  368.                                                             rexxmsg^.args [2],
  369.                                                             S.ADR (tags)));
  370.         ok := rx.ok
  371.       ELSIF s0.Compare (rexxmsg^.args [0]^, "PGPDecrypt", FALSE) THEN
  372.         IF NumArgs () >= 3 THEN
  373.           tags [0].tag  := tagOutFile;
  374.           tags [0].data := rexxmsg^.args [3]
  375.         ELSE
  376.           tags [0].tag  := u.ignore
  377.         END;
  378.         IF NumArgs () >= 4 THEN
  379.           tags [1].tag  := tagConOutput;
  380.           tags [1].data := rexxmsg^.args [4]
  381.         ELSE
  382.           tags [1].tag  := u.ignore
  383.         END;
  384.         tags [2].tag  := u.done;
  385.         p.LSPrintF (result^, LEN (result^), "%ld", Decrypt (rexxmsg^.args [1],
  386.                                                             rexxmsg^.args [2],
  387.                                                             S.ADR (tags)));
  388.         ok := rx.ok
  389.       ELSIF s0.Compare (rexxmsg^.args [0]^, "PGPFault", FALSE) THEN
  390.         IF c.StringToInt (rexxmsg^.args [1]^, code) THEN
  391.           IF Fault (code, rexxmsg^.args [2], S.ADR (result^), LEN (result^)) # 0 THEN END
  392.         END;
  393.         ok := rx.ok
  394.       ELSIF s0.Compare (rexxmsg^.args [0]^, "PGPSign", FALSE) THEN
  395.         IF NumArgs () >= 3 THEN
  396.           tags [0].tag  := tagOutFile;
  397.           tags [0].data := rexxmsg^.args [3]
  398.         ELSE
  399.           tags [0].tag  := u.ignore
  400.         END;
  401.         IF NumArgs () >= 4 THEN
  402.           tags [1].tag  := tagUserId;
  403.           tags [1].data := rexxmsg^.args [4]
  404.         ELSE
  405.           tags [1].tag  := u.ignore
  406.         END;
  407.         IF NumArgs () >= 5 THEN
  408.           tags [2].tag  := tagConOutput;
  409.           tags [2].data := rexxmsg^.args [5]
  410.         ELSE
  411.           tags [2].tag  := u.ignore
  412.         END;
  413.         tags [3].tag  := u.done;
  414.         p.LSPrintF (result^, LEN (result^), "%ld", Sign (rexxmsg^.args [1],
  415.                                                          rexxmsg^.args [2],
  416.                                                          S.ADR (tags)));
  417.         ok := rx.ok
  418.       END;
  419.       (* $OddChk= *)
  420.       IF ok = rx.ok THEN
  421.         resultstring := rs.CreateArgstring (result^, s.Length (result^));
  422.         IF resultstring # NIL THEN
  423.           S.SETREG (8, resultstring)
  424.         ELSE
  425.           ok := rx.err10003
  426.         END
  427.       END;
  428.       DISPOSE (result)
  429.     END
  430.   END;
  431.   RETURN ok
  432. END ARexxQuery;
  433.  
  434. BEGIN
  435.   IF d.GetVar ("pgppath", pgppath, LEN (pgppath), LONGSET {d.globalOnly}) = -1 THEN
  436.     HALT (d.fail)
  437.   END
  438. END pgplib.
  439.